home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mttermin.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  30.7 KB  |  1,013 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtTerminal;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *  3.01     | 31.01.92 |  Hp  | Bug in OpenTerminal gefixt, der dazu   *
  29.  *           |          |      | fhrte, daž die falsche Fontgr”že ein- *
  30.  *           |          |      | gestellt wurde.                        *
  31.  *  3.02     | 03.02.92 |  Hp  | Uralt-Bug in Emulator gefixt.          *
  32.  *           |          |      | M„hnie Z„nks to Steffen Engel @ PE     *
  33.  *-----------+----------+------+----------------------------------------*)
  34.  
  35.  
  36.  
  37. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  38. (*                                              *)
  39. (*$R-   Range-Checks                            *)
  40. (*$S-   Stack-Check                             *)
  41. (*                                              *)
  42. (*----------------------------------------------*)
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  52.  
  53.  
  54.  
  55.  
  56. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  57.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  58.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  59.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  60.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  61.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  62.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  63.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70. FROM SYSTEM             IMPORT  ADDRESS, ADR, TSIZE;
  71. FROM MagicStrings       IMPORT  Assign, Append, Length;
  72. FROM MagicConvert       IMPORT  CardToStr, IntToStr, LCardToStr, LIntToStr,
  73.                                 LRealToStr, RealToStr, FixRealToStr, FixLRealToStr;
  74. FROM MagicVDI           IMPORT  VDIIntIn, VDIPtsIn, VDICall;
  75. FROM mtAppl             IMPORT  VDIHandle, MaxWidth, MaxHeight, Bitplanes,
  76.                                 CharWidth, CharHeight, BoxWidth, BoxHeight,
  77.                                 OpenWorkstation, CloseWorkstation, MouseOn,
  78.                                 MouseOff, Screen;
  79. FROM mtFonts            IMPORT  FontInfo, FontActive, FontSelect, FontSize,
  80.                                 FontDefsize, FontRotate, tFontinfo;
  81. FROM mtUtils            IMPORT  tRect;
  82. IMPORT  MagicBIOS, MagicDOS, MagicAES, MagicVDI, mtFonts;
  83.  
  84.  
  85.  
  86. (*--------------------------------------------------------------------------*
  87.  *                      Zustandsflags des Terminals                         *
  88.  *--------------------------------------------------------------------------*)
  89.  
  90. CONST   cActive =       0;      (* Terminal aktiv (Vordergrund)             *)
  91.         cErase =        1;      (* Zeichen vorl”schen?                      *)
  92.         cCursor =       2;      (* Cursor ein?                              *)
  93.         cBlink =        3;      (* Cursor blinkend?                         *)
  94.         cWrap =         4;      (* Word-Wrapping                            *)
  95.         cEscape =       5;      (* Escape wurde ausgegeben                  *)
  96.         cEscYs =        6;      (* Escape Y: Spaltenwert wird erwartet      *)
  97.         cEscYz =        7;      (* Escape Y: Zeilenwert wird erwartet       *)
  98.         cEscb =         8;      (* Escape b: Vordergrundfarbe wird erwartet *)
  99.         cEscc =         9;      (* Escape c: Hintergrundfarbe wird erwartet *)
  100.         cBColor =      10;      (* Hintergrundfarbe beim Schreiben          *)
  101.         cRedraw =      11;      (* Redrawfeature eingeschaltet              *)
  102.         cFSM =         12;      (* Gesetzt wenn der Font ein FSM-Font ist   *)
  103.         cFlag13 =      13;
  104.         cFlag14 =      14;
  105.         cFlag15 =      15;
  106.  
  107. (*--------------------------------------------------------------------------*)
  108.  
  109. TYPE    TERMINAL =      POINTER TO TerminalTyp;
  110.         TerminalTyp =   RECORD
  111.                          x:       sINTEGER;  (* X-Koordinate                 *)
  112.                          y:       sINTEGER;  (* Y-Koordinate                 *)
  113.                          px:      sINTEGER;  (* X-Pixelpos des Cursor        *)
  114.                          py:      sINTEGER;  (* Y-Pixelpos des Cursors       *)
  115.                          mx:      sINTEGER;  (* Position rechter Rand        *)
  116.                          my:      sINTEGER;  (* Position linker Rand         *)
  117.                          lastCol: sINTEGER;  (* Pixelpos der letzten Spalte  *)
  118.                          lastLn:  sINTEGER;  (* Pixelpos der letzten Zeile   *)
  119.                          zBreite: sINTEGER;  (* Zeichenbreite                *)
  120.                          zHoehe:  sINTEGER;  (* Zeichenh”he                  *)
  121.                          pmx:     sINTEGER;  (* Cursor-Breite                *)
  122.                          pmy:     sINTEGER;  (* Cursor-H”he                  *)
  123.                          sx:      sINTEGER;  (*  *)
  124.                          sy:      sINTEGER;  (*  *)
  125.                          ox:      sINTEGER;  (*  *)
  126.                          xoff:    sINTEGER;  (* Offset fr kursive Schrift   *)
  127.                          yoff:    sINTEGER;  (* fr tiefgestellte Schrift    *)
  128.                          w:       sINTEGER;  (* Breite in Pixel              *)
  129.                          h:       sINTEGER;  (* H”he in Pixel                *)
  130.                          sp:      sINTEGER;  (* Anzahl der Spalten           *)
  131.                          zl:      sINTEGER;  (* Anzahl der Zeilen            *)
  132.                          wert1:   sINTEGER;  (* Zwischenspeicher             *)
  133.                          wert2:   sINTEGER;  (* Zwischenspeicher             *)
  134.                          vColor:  sINTEGER;  (* Vordergrundfarbe (Text)      *)
  135.                          hColor:  sINTEGER;  (* Hintergrundfarbe             *)
  136.                          tab:     sINTEGER;  (* Tabweite                     *)
  137.                          size:    sINTEGER;  (* Fontgr”že                    *)
  138.                          full:    sINTEGER;  (* Volle Fontgr”že              *)
  139.                          half:    sINTEGER;  (* Halbe Fontgr”že              *)
  140.                          font:    sINTEGER;  (* Fontnummer                   *)
  141.                          effect:  Attribut;  (* Texteffekte                  *)
  142.                          zustand: sBITSET;   (* Zustand des Terminals        *)
  143.                         END; (* TerminalTyp *)
  144.  
  145. (*--------------------------------------------------------------------------*)
  146.  
  147. VAR     d, q:           MagicVDI.MFDB;
  148.         dPtr:           ADDRESS;
  149.         qPtr:           ADDRESS;
  150.  
  151. VAR     control7:       POINTER TO ADDRESS;
  152.         control9:       POINTER TO ADDRESS;
  153.  
  154. VAR     InversHandle:   sINTEGER;
  155.         NormalHandle:   sINTEGER;
  156.  
  157. VAR     rect:           tRect; 
  158.         rect2:          tRect;
  159.  
  160. VAR     Status:         sINTEGER;
  161.         
  162. VAR     MaxLines:       sINTEGER;  (* max. Anzahl Zeilen des Bildschirms     *)
  163.         MaxColumns:     sINTEGER;  (* max. Anzahl Spalten des Bildschirms    *)
  164.         MinX:           sINTEGER;  (* Ursprung des Bildschirms               *)
  165.         MinY:           sINTEGER;
  166.  
  167. (*--------------------------------------------------------------------------*)
  168.  
  169.  
  170.   VAR conterm[0484H]: ByteSet;  
  171.  
  172.  
  173.  
  174. PROCEDURE Glocke;
  175. CONST glocke = 2;
  176. VAR   stack:   ADDRESS;
  177. BEGIN
  178.  stack:= 0;  MagicDOS.Super (stack);
  179.  
  180.  
  181.  
  182.  
  183.   IF (glocke IN conterm) THEN  MagicBIOS.Bconout (MagicBIOS.CON, CHR(7));  END;
  184.  
  185.  MagicDOS.Super (stack);
  186. END Glocke;
  187.  
  188. PROCEDURE Cursor;
  189. (* Schaltet Cursor ein und aus, XOR-Modus *)
  190. BEGIN
  191.  WITH Terminal^ DO
  192.   IF cCursor IN zustand THEN
  193.    VDIPtsIn[0]:= px;
  194.    VDIPtsIn[1]:= py;
  195.    VDIPtsIn[2]:= pmx;
  196.    VDIPtsIn[3]:= pmy;
  197.    VDICall(114, 2, 0, 0, InversHandle);
  198.   END; (* IF cCursor *)
  199.  END; (* WITH *)
  200. END Cursor;
  201.  
  202. PROCEDURE Scrollup;
  203. (* Geht davon aus, daž Maus und Cursor aus sind. Diese Routine wird nur
  204.  * intern aufgerufen, so daž dieses Vorgehen keine Probleme bereitet
  205.  *)
  206. BEGIN
  207.  WITH Terminal^ DO
  208.   VDIPtsIn[0]:= x;
  209.   VDIPtsIn[1]:= y + zHoehe;
  210.   VDIPtsIn[2]:= mx;
  211.   VDIPtsIn[3]:= my;
  212.   VDIPtsIn[4]:= x;
  213.   VDIPtsIn[5]:= y;
  214.   VDIPtsIn[6]:= mx;
  215.   VDIPtsIn[7]:= lastLn;
  216.   VDIIntIn[0]:= 3;
  217.   control7^:= qPtr;
  218.   control9^:= dPtr;
  219.   VDICall(109, 4, 1, 0, NormalHandle);
  220.   VDIPtsIn[0]:= x;
  221.   VDIPtsIn[1]:= lastLn;
  222.   VDIPtsIn[2]:= mx;
  223.   VDIPtsIn[3]:= my;
  224.   VDICall (114, 2, 0, 0, NormalHandle);
  225.  END;
  226. END Scrollup;
  227.  
  228. PROCEDURE Emulator (ch: CHAR);
  229. (* Handled alles, was mit Escape eingeleitet wurde *)
  230. BEGIN
  231.  WITH Terminal^ DO
  232.   IF cEscYs IN zustand THEN
  233.    wert1:= ORD(ch) - 32;
  234.    EXCL (zustand, cEscYs);  INCL (zustand, cEscYz);  RETURN;
  235.   END;
  236.   IF cEscYz IN zustand THEN
  237.    wert2:= ORD(ch) - 32;  IF wert2 < 0 THEN wert2:= 0; END;
  238.    GotoXY (wert2, wert1);
  239.    EXCL (zustand, cEscYz);  EXCL (zustand, cEscape);  RETURN;
  240.   END;   
  241.   IF cEscb IN zustand THEN
  242.    ForegroundColor (ORD (ch));
  243.    EXCL (zustand, cEscb);  EXCL (zustand, cEscape);  RETURN;
  244.   END;   
  245.   IF cEscc IN zustand THEN
  246.    BackgroundColor (ORD (ch));
  247.    EXCL (zustand, cEscc);  EXCL (zustand, cEscape);  RETURN;
  248.   END;
  249.   CASE ch OF
  250.    'A': IF py > y  THEN  DEC (py, zHoehe);  DEC (pmy, zHoehe);  END;|
  251.    'B': IF py < lastLn  THEN  INC (py, zHoehe);  INC (pmy, zHoehe);  END;|
  252.    'C': IF px < lastCol  THEN INC(px, zBreite);  INC(pmx, zBreite);  END;|
  253.    'D': IF px > x  THEN  DEC (px, zBreite);  DEC (pmx, zBreite);  END;|
  254.    'E': ClearScreen;|
  255.    'H': GotoXY (0, 0);|
  256.    'I': IF py > y THEN  DEC (py, zHoehe);  DEC (pmy, zHoehe);  END;
  257.         IF py = y THEN  InsertLine;  END;|
  258.    'J': ClearEndOfScreen;|
  259.    'K': ClearEndOfLine;|
  260.    'L': InsertLine;|
  261.    'M': DeleteLine;|
  262.    'Y': INCL (zustand, cEscYs);  RETURN;|
  263.    'b': INCL (zustand, cEscb);   RETURN;|
  264.    'c': INCL (zustand, cEscc);   RETURN;|
  265.    'd': ClearStartOfScreen;|
  266.    'e': CursorOn;|
  267.    'f': CursorOff;|
  268.    'j': sx:= px;  sy:= py;|
  269.    'k': px:= sx;  py:= sy;  pmx:= px + zBreite;  pmy:= py + zHoehe;|
  270.    'l': ClearLine;  px:= x;  pmx:= px + zBreite;|
  271.    'o': ClearStartOfLine;|
  272.    'p': INCL (effect, invers);|
  273.    'q': EXCL (effect, invers);|
  274.    'v': INCL (zustand, cWrap);|
  275.    'w': EXCL (zustand, cWrap);|
  276.    200C..377C: SetAttribut (Attribut (ch));|
  277.    ELSE;
  278.   END; (* CASE *)
  279.   EXCL(zustand, cEscape);
  280.  END; (* WITH *)  
  281. END Emulator;
  282.  
  283. PROCEDURE ControlChar (ch: CHAR);
  284. (* Bearbeitet alles was kleiner als Blank ist *)
  285. VAR b: Attribut;
  286.     s: sINTEGER;
  287. BEGIN
  288.  WITH Terminal^ DO
  289.   CASE ORD(ch) OF
  290.     0:  |
  291.     7:  Glocke;
  292.         |
  293.     8:  (* Backspace *)
  294.         IF px > x THEN  DEC (px, zBreite);  DEC (pmx, zBreite); END;
  295.         VDIPtsIn[0]:= px;  VDIPtsIn[1]:= py;
  296.         VDIPtsIn[2]:= pmx;  VDIPtsIn[3]:= pmy;
  297.         VDICall (114, 2, 0, 0, NormalHandle);
  298.         |
  299.     9:  (* TAB *)
  300.         s:= x + (((((px - x) DIV zBreite) DIV tab) + 1) * tab) * zBreite;
  301.         DEC (s, zBreite);
  302.         IF (px + s) < lastCol THEN  px:= s;  ELSE  px:= lastCol;  END;
  303.         pmx:= px + zBreite;
  304.         |
  305.    10:  (* Linefeed *)
  306.         INC(py, zHoehe);
  307.         IF py > lastLn THEN  py:= lastLn;  Scrollup;  END;
  308.         pmy:= py + zHoehe;
  309.         |
  310.    12:  (* Home *)
  311.         ClearScreen;
  312.         |
  313.    13:  (* Carriage-Return *)
  314.         px:= x;  pmx:= px + zBreite;
  315.         |
  316.    27:  (* Escape *)
  317.         INCL(zustand, cEscape);
  318.         |
  319.    ELSE b:= effect;  INCL (effect, invers);
  320.         WriteChar (CHR(ORD(ch)+ 64));
  321.         effect:= b;
  322.   END; (* CASE *)
  323.  END; (* WITH *)
  324. END ControlChar;
  325.  
  326. PROCEDURE DoWrite (anzahl: sINTEGER);
  327. BEGIN
  328.  WITH Terminal^ DO
  329.   (* Position *)
  330.   VDIPtsIn[0]:= ox;
  331.   VDIPtsIn[1]:= py;
  332.   (* Vorl”schen? *)
  333.   IF {cErase, cBColor} <= zustand THEN
  334.    VDIPtsIn[2]:= px;  VDIPtsIn[3]:= pmy;
  335.    VDICall (114, 2, 0, 0, NormalHandle);
  336.   END;
  337.   INC (VDIPtsIn[0], xoff);
  338.   INC (VDIPtsIn[1], yoff);
  339.   VDICall (8, 1, anzahl, 0, TextHandle);
  340.   (* Invers? *)
  341.   IF invers IN effect THEN
  342.    VDIPtsIn[0]:= ox;
  343.    VDIPtsIn[1]:= py;
  344.    VDIPtsIn[2]:= px - sINTEGER(1);
  345.    VDIPtsIn[3]:= pmy-1;
  346.    VDICall (114, 2, 0, 0, InversHandle);
  347.   END;
  348.  END;
  349. END DoWrite;
  350.  
  351. PROCEDURE WriteChar (ch: CHAR);
  352. VAR i: sINTEGER;
  353. BEGIN
  354.  MouseOff;  Cursor;
  355.  WITH Terminal^ DO
  356.   IF cEscape IN zustand THEN
  357.    Emulator(ch);   (* Esape-Code abhandeln *)
  358.  
  359.   ELSIF  ORD(ch) < 32 THEN
  360.    ControlChar(ch);  (* Control-Code abhandeln *)
  361.  
  362.   ELSE
  363.   
  364.    (* Normales Zeichen *)
  365.    IF px > lastCol THEN
  366.     IF cWrap IN zustand THEN
  367.      px:= x;  INC(py, zHoehe);
  368.      IF py > lastLn THEN  py:= lastLn;  Scrollup;  END;
  369.      pmx:= px + zBreite;  pmy:= py + zHoehe;
  370.     ELSE
  371.      px:= lastCol;  pmx:= px + zBreite;
  372.     END;
  373.    END;
  374.    ox:= px;  INC(px, zBreite);
  375.    VDIIntIn[0]:= ORD(ch);  VDIIntIn[1]:= 0;
  376.    DoWrite (1);
  377.    pmx:= px + zBreite;  pmy:= py + zHoehe;
  378.    Cursor;
  379.   END; (* IF *)
  380.  END; (* WITH *)
  381. END WriteChar;
  382.  
  383.  PROCEDURE WriteLine (REF string: ARRAY OF CHAR); 
  384.  
  385. VAR c, d, l: sCARDINAL;
  386.     i, j: sINTEGER;
  387.     char: CHAR;
  388. BEGIN
  389.  MouseOff;  Cursor;  c:= 0;  l:= HIGH(string);
  390.  LOOP
  391.   IF (c > l) THEN  EXIT;  END;  (* String zu Ende *)
  392.   CASE ORD (string[c]) OF
  393.     0:      EXIT; (* String zu Ende *)
  394.             |
  395.    27:      INC(c);
  396.             INCL(Terminal^.zustand, cEscape);
  397.             WHILE cEscape IN Terminal^.zustand DO
  398.              Emulator (string[c]);
  399.              INC(c);  IF (c > l) THEN  EXIT;  END;
  400.             END;
  401.             |
  402.    1..26,
  403.    28..31:  ControlChar(string[c]);  INC(c);
  404.             |
  405.    ELSE  (* Scanne String bis Zeichen < Blank und gebe ihn aus *)
  406.     WITH Terminal^ DO
  407.      d:= 0;  ox:= px;  
  408.      WHILE (px <= lastCol) & (string[c] > 37C) & (c <= l) DO
  409.       VDIIntIn[d]:= ORD(string[c]);  INC(d);  INC(c);  INC(px, zBreite);
  410.      END;
  411.      VDIIntIn[d]:= 0;
  412.      IF ox < lastCol THEN  DoWrite (d);  END;
  413.      IF px >= lastCol THEN
  414.       IF cWrap IN zustand THEN
  415.        px:= x;  INC(py, zHoehe);
  416.        IF py > lastLn THEN py:= lastLn;  Scrollup; END;
  417.        pmx:= px + zBreite;  pmy:= py + zHoehe;
  418.       ELSE
  419.        px:= lastCol;  pmx:= px + zBreite;
  420.       END;
  421.      END;
  422.     END; (* WITH *)
  423.   END; (* CASE *)
  424.  END; (* LOOP *)
  425.  WITH Terminal^ DO  pmx:= px + zBreite;  END;
  426.  Cursor;
  427. END WriteLine;
  428.  
  429. PROCEDURE WriteConst (REF string: ARRAY OF CHAR);
  430. BEGIN
  431.  WriteLine(string);
  432. END WriteConst;
  433.  
  434. PROCEDURE WriteLn;
  435. BEGIN
  436.  MouseOff;  Cursor;
  437.  WITH Terminal^ DO
  438.   px:= x;
  439.   INC(py, zHoehe);
  440.   IF py > lastLn THEN py:= lastLn;  Scrollup; END;
  441.   pmx:= px + zBreite;  pmy:= py + zHoehe;
  442.  END;
  443.  Cursor;
  444. END WriteLn;
  445.  
  446. VAR string: ARRAY [0..255] OF CHAR;
  447.  
  448. PROCEDURE WriteCard (wert: sCARDINAL; len: sCARDINAL);
  449. BEGIN
  450.  CardToStr (wert, len, string);
  451.  WriteLine (string);
  452. END WriteCard;
  453.  
  454. PROCEDURE WriteInt (wert: sINTEGER; len: sCARDINAL);
  455. BEGIN
  456.  IntToStr (wert, len, string);
  457.  WriteLine (string);
  458. END WriteInt;
  459.  
  460. PROCEDURE WriteLongCard (wert: lCARDINAL; len: sCARDINAL);
  461. BEGIN
  462.  LCardToStr (wert, len, string);
  463.  WriteLine (string);
  464. END WriteLongCard;
  465.  
  466. PROCEDURE WriteLongInt (wert: lINTEGER;  len: sCARDINAL);
  467. BEGIN
  468.  LIntToStr (wert, len, string);
  469.  WriteLine (string);
  470. END WriteLongInt;
  471.  
  472. PROCEDURE WriteReal (wert: REAL; len: sCARDINAL);
  473. BEGIN
  474.  RealToStr (wert, len, string);
  475.  WriteLine (string);
  476. END WriteReal;
  477.  
  478. PROCEDURE WriteLongReal (wert: LONGREAL; len: sCARDINAL);
  479. BEGIN
  480.  LRealToStr (wert, len, string);
  481.  WriteLine (string);
  482. END WriteLongReal;
  483.  
  484. PROCEDURE WriteFixReal (wert: REAL; len, fix: sCARDINAL);
  485. BEGIN
  486.  FixRealToStr (wert, len, fix, string);
  487.  WriteLine (string);
  488. END WriteFixReal;
  489.  
  490. PROCEDURE WriteFixLReal (wert: LONGREAL; len, fix: sCARDINAL);
  491. BEGIN
  492.  FixLRealToStr (wert, len, fix, string);
  493.  WriteLine (string);
  494. END WriteFixLReal;
  495.  
  496. PROCEDURE InsertLine;
  497. BEGIN
  498.  WITH Terminal^ DO
  499.   MouseOff;  Cursor;  px:= x;  pmx:= px + zBreite;
  500.   VDIPtsIn[0]:= px;
  501.   VDIPtsIn[1]:= py;
  502.   VDIPtsIn[2]:= mx;
  503.   VDIPtsIn[3]:= my - zHoehe;
  504.   VDIPtsIn[4]:= px;
  505.   VDIPtsIn[5]:= py + zHoehe;
  506.   VDIPtsIn[6]:= mx;
  507.   VDIPtsIn[7]:= my;
  508.   VDIIntIn[0]:= 3;
  509.   control7^:= qPtr;
  510.   control9^:= dPtr;
  511.   VDICall (109, 4, 1, 0, NormalHandle);
  512.   VDIPtsIn[0]:= x;
  513.   VDIPtsIn[1]:= py;
  514.   VDIPtsIn[2]:= mx;
  515.   VDIPtsIn[3]:= pmy;
  516.   VDICall (114, 2, 0, 0, NormalHandle);
  517.  END;
  518. END InsertLine;
  519.  
  520. PROCEDURE DeleteLine;
  521. BEGIN
  522.  WITH Terminal^ DO
  523.   MouseOff;  Cursor;  px:= x;  pmx:= px + zBreite;
  524.   VDIPtsIn[0]:= px;
  525.   VDIPtsIn[1]:= py + zHoehe;
  526.   VDIPtsIn[2]:= mx;
  527.   VDIPtsIn[3]:= my;
  528.   VDIPtsIn[4]:= px;
  529.   VDIPtsIn[5]:= py;
  530.   VDIPtsIn[6]:= mx;
  531.   VDIPtsIn[7]:= lastLn;
  532.   VDIIntIn[0]:= 3;
  533.   control7^:= qPtr;
  534.   control9^:= dPtr;
  535.   VDICall (109, 4, 1, 0, NormalHandle);
  536.   VDIPtsIn[0]:= x;
  537.   VDIPtsIn[1]:= lastLn;
  538.   VDIPtsIn[2]:= mx;
  539.   VDIPtsIn[3]:= my;
  540.   VDICall (114, 2, 0, 0, NormalHandle);
  541.  END;
  542. END DeleteLine;
  543.  
  544. PROCEDURE WhereXY (VAR spalte, zeile: sCARDINAL);
  545. BEGIN
  546.  WITH Terminal^ DO
  547.   spalte:= (px - x) DIV zBreite;
  548.   zeile:=  (py - y) DIV zHoehe;
  549.  END;
  550. END WhereXY;
  551.  
  552. PROCEDURE GotoXY (spalte, zeile: sCARDINAL);
  553. (* Die Home-Position wurde auf 0, 0 festgelegt *)
  554. BEGIN
  555.  WITH Terminal^ DO
  556.   MouseOff;  Cursor; (* Cursor ausschalten *)
  557.   px:= x + (CastToInt (spalte) * zBreite); 
  558.   py:= y + (CastToInt (zeile) * zHoehe);
  559.   IF px < x THEN px:= x; END;
  560.   IF py < y THEN py:= y; END;
  561.   IF px > mx THEN px:= mx - zBreite; END;
  562.   IF py > lastLn THEN py:= lastLn; END;
  563.   pmx:= px + zBreite;  pmy:= py + zHoehe;
  564.   Cursor;
  565.  END; (* WITH *)
  566. END GotoXY;
  567.  
  568. PROCEDURE WhereCursor (VAR x, y: sINTEGER);
  569. BEGIN
  570.  x:= Terminal^.px;
  571.  y:= Terminal^.py;
  572. END WhereCursor;
  573.  
  574. PROCEDURE SetCursor (xx, yy: sINTEGER);
  575. VAR bb, hh: sINTEGER;
  576. BEGIN
  577.  WITH Terminal^ DO
  578.   MouseOff;  Cursor; (* Cursor ausschalten *)
  579.   px:= xx;  py:= yy;
  580.   IF px < x THEN px:= x; END;
  581.   IF py < y THEN py:= y; END;
  582.   IF px > mx THEN px:= mx - zBreite; END;
  583.   IF py > lastLn THEN py:= lastLn; END;
  584.   pmx:= px + 2;
  585.   pmy:= py + zHoehe - 1;
  586.   Cursor;
  587.  END; (* WITH *)
  588. END SetCursor;
  589.  
  590. PROCEDURE CursorOn;
  591. BEGIN
  592.  IF NOT (cCursor IN Terminal^.zustand) THEN
  593.   MouseOff;  INCL(Terminal^.zustand, cCursor);  Cursor;
  594.  END;
  595. END CursorOn;
  596.  
  597. PROCEDURE CursorOff;
  598. BEGIN
  599.  IF cCursor IN Terminal^.zustand THEN
  600.   MouseOff;  Cursor;  EXCL(Terminal^.zustand, cCursor);
  601.  END;
  602. END CursorOff;
  603.  
  604. PROCEDURE CursorStop;
  605. (* Wird ggw. nicht untersttzt *)
  606. END CursorStop;
  607.  
  608. PROCEDURE CursorBlink;
  609. (* Wird ggw. nicht untersttzt *)
  610. END CursorBlink;
  611.  
  612. PROCEDURE WrapOff;
  613. BEGIN
  614.  EXCL(Terminal^.zustand, cWrap);
  615. END WrapOff;
  616.  
  617. PROCEDURE WrapOn;
  618. BEGIN
  619.  INCL(Terminal^.zustand, cWrap);
  620. END WrapOn;
  621.  
  622. PROCEDURE ClearLine;
  623. BEGIN
  624.  WITH Terminal^ DO
  625.   MouseOff;  Cursor;  px:= x;  pmx:= px + zBreite;
  626.   VDIPtsIn[0]:= x;
  627.   VDIPtsIn[1]:= py;
  628.   VDIPtsIn[2]:= x + w -1;
  629.   VDIPtsIn[3]:= pmy;
  630.   VDICall (114, 2, 0, 0, NormalHandle);
  631.   Cursor;
  632.  END;
  633. END ClearLine;
  634.  
  635. PROCEDURE ClearStartOfLine;
  636. BEGIN
  637.  WITH Terminal^ DO
  638.   MouseOff;  Cursor;
  639.   VDIPtsIn[0]:= x;
  640.   VDIPtsIn[1]:= py;
  641.   VDIPtsIn[2]:= px;
  642.   VDIPtsIn[3]:= pmy;
  643.   VDICall (114, 2, 0, 0, NormalHandle);
  644.   Cursor;
  645.  END;
  646. END ClearStartOfLine;
  647.  
  648. PROCEDURE ClearEndOfLine;
  649. BEGIN
  650.  WITH Terminal^ DO
  651.   MouseOff;  Cursor;
  652.   VDIPtsIn[0]:= px;
  653.   VDIPtsIn[1]:= py;
  654.   VDIPtsIn[2]:= x + w - 1;
  655.   VDIPtsIn[3]:= pmy;
  656.   VDICall (114, 2, 0, 0, NormalHandle);
  657.   Cursor;
  658.  END;
  659. END ClearEndOfLine;
  660.  
  661. PROCEDURE ClearScreen;
  662. BEGIN
  663.  WITH Terminal^ DO
  664.   MouseOff;  Cursor;  GotoXY (0, 0);
  665.   VDIPtsIn[0]:= px;
  666.   VDIPtsIn[1]:= py;
  667.   VDIPtsIn[2]:= x + w - 1;
  668.   VDIPtsIn[3]:= y + h - 1;
  669.   VDICall (114, 2, 0, 0, NormalHandle);
  670.   Cursor;
  671.  END; (* WITH *)
  672. END ClearScreen;
  673.  
  674. PROCEDURE ClearStartOfScreen;
  675. BEGIN
  676.  WITH Terminal^ DO
  677.   MouseOff;  Cursor;
  678.   VDIPtsIn[0]:= px;
  679.   VDIPtsIn[1]:= py;
  680.   VDIPtsIn[2]:= x;
  681.   VDIPtsIn[3]:= pmy;
  682.   VDICall (114, 2, 0, 0, NormalHandle);
  683.   VDIPtsIn[0]:= x;
  684.   VDIPtsIn[1]:= y;
  685.   VDIPtsIn[2]:= x + w - 1;
  686.   VDIPtsIn[3]:= py;
  687.   VDICall (114, 2, 0, 0, NormalHandle);
  688.   Cursor;
  689.  END; (* WITH *)
  690. END ClearStartOfScreen;
  691.  
  692. PROCEDURE ClearEndOfScreen;
  693. BEGIN
  694.  WITH Terminal^ DO
  695.   MouseOff;  Cursor;
  696.   VDIPtsIn[0]:= px;
  697.   VDIPtsIn[1]:= py;
  698.   VDIPtsIn[2]:= x + w - 1;
  699.   VDIPtsIn[3]:= pmy;
  700.   VDICall (114, 2, 0, 0, NormalHandle);
  701.   VDIPtsIn[0]:= x;
  702.   VDIPtsIn[1]:= py + zHoehe;
  703.   VDIPtsIn[2]:= x + w - 1;
  704.   VDIPtsIn[3]:= y + h - 1;
  705.   VDICall (114, 2, 0, 0, NormalHandle);
  706.   Cursor;
  707.  END; (* WITH *)
  708. END ClearEndOfScreen;
  709.  
  710. PROCEDURE ForegroundColor (color: sINTEGER);
  711. VAR old: sINTEGER;
  712. BEGIN
  713.  Terminal^.vColor:= color;
  714.  old:= MagicVDI.SetTextcolor (TextHandle, color);
  715.  old:= MagicVDI.SetFillcolor (InversHandle, color); 
  716. END ForegroundColor;
  717.  
  718. PROCEDURE BackgroundColor (color: sINTEGER);
  719. VAR old, wm: sINTEGER;
  720. BEGIN
  721.  Terminal^.hColor:= color;
  722.  old:= MagicVDI.SetFillcolor (NormalHandle, color); 
  723.  IF color > 0 THEN
  724.   INCL (Terminal^.zustand, cBColor);
  725.   wm:= MagicVDI.SetWritemode (TextHandle, MagicVDI.XOR);
  726.  ELSE
  727.   EXCL (Terminal^.zustand, cBColor);
  728.   wm:= MagicVDI.SetWritemode (TextHandle, MagicVDI.REPLACE);
  729.  END;
  730. END BackgroundColor;
  731.  
  732. PROCEDURE InversOn;
  733. BEGIN
  734.  INCL (Terminal^.effect, invers);
  735. END InversOn;
  736.  
  737. PROCEDURE InversOff;
  738. BEGIN
  739.  EXCL (Terminal^.effect, invers);
  740. END InversOff;
  741.  
  742. PROCEDURE SetAttribut (attrib: Attribut);
  743. VAR i:  sINTEGER;
  744.     bs: sBITSET;
  745. BEGIN
  746.  MouseOff;
  747.  WITH Terminal^ DO
  748.   IF Attribut{subscript, superscript, italic} <= attrib THEN
  749.    (* Das zu schreibende Zeichen muž am Bildschirm vorgel”scht werden *)
  750.    INCL(zustand, cErase);
  751.   END;
  752.  
  753.   (* Bei kursiver Schrift muž das Zeichen um einen Offset nach rechts
  754.    * verschoben werden, da durch die Umsetzung des Alignments das Zeichen
  755.    * nach links gezeichnet wird (kompliziert, ich geb's zu...)
  756.    *)
  757.   IF italic IN attrib THEN
  758.    xoff:= zBreite DIV 2;
  759.    rect.x:= x;  rect.y:= y;  rect.w:= x + w - 2;  rect.h:= y + h - 2;
  760.    MagicVDI.SetClipping(TextHandle, rect, TRUE);
  761.   ELSIF italic IN effect THEN
  762.    xoff:= 0;
  763.    MagicVDI.SetClipping(TextHandle, rect, FALSE);
  764.   ELSE
  765.    xoff:= 0;
  766.   END;
  767.  
  768.   (* Beim Tiefstellen von Zeichen muž noch ein Offset addiert werden,
  769.    * da unsere Cursorposition immer die oberste Rasterzeile des Zeichens
  770.    * beschreibt.
  771.    *)
  772.   IF Attribut{subscript, superscript} <= attrib THEN
  773.    yoff:= zHoehe DIV 4;
  774.    size:= MagicVDI.SetCharpoints (TextHandle, half, i, i, i, i);
  775.   ELSIF subscript IN attrib THEN
  776.    yoff:= zHoehe DIV 2;
  777.    size:= MagicVDI.SetCharpoints (TextHandle, half, i, i, i, i);
  778.   ELSIF superscript IN attrib THEN
  779.    yoff:= 0;
  780.    size:= MagicVDI.SetCharpoints (TextHandle, half, i, i, i, i);
  781.   ELSE (* Normale Zeichenh”he *)
  782.    yoff:= 0;
  783.    size:= MagicVDI.SetCharpoints (TextHandle, full, i, i, i, i);
  784.   END;
  785.  
  786.   (* Leider werden nicht alle verwendeten Attribute vom VDI untersttzt.
  787.    * So werden Hoch-, Tiefstellen und Invers in MagicTerm emuliert.
  788.    * Diese Bits mssen wir ausblenden, sonst gibts Verwirrung
  789.    *)
  790.   bs:= {};
  791.   IF fat IN attrib THEN  INCL (bs, MagicVDI.Fat);  END;
  792.   IF light IN attrib THEN  INCL (bs, MagicVDI.Light);  END;
  793.   IF italic IN attrib THEN  INCL (bs, MagicVDI.Italic);  END;
  794.   IF underline IN attrib THEN  INCL (bs, MagicVDI.Underline);  END;
  795.    
  796.   VDIIntIn[0]:= CastToInt (bs);
  797.   
  798.   VDICall (106, 0, 1, 0, TextHandle);
  799.  
  800.   effect:= attrib;
  801.  END; (* WITH *)
  802. END SetAttribut;
  803.  
  804. PROCEDURE SetTabspace (tab: sINTEGER);
  805. BEGIN
  806.  Terminal^.tab:= tab;
  807. END SetTabspace;
  808.  
  809. PROCEDURE SetParameter;
  810. BEGIN
  811.  WITH Terminal^ DO
  812.   Lines:= zl;  Columns:= sp;
  813.   Xpos:= x;  Ypos:= y;  Width:= w;  Height:= h;
  814.   CurrWidth:= zBreite;  CurrHeight:= zHoehe;
  815.  END;
  816. END SetParameter;
  817.  
  818. (*--------------------------------------------------------------------------*
  819.  *                              GDOS-Fonthandling                           *
  820.  *--------------------------------------------------------------------------*)
  821.  
  822. PROCEDURE UpdateTerminal;
  823. VAR info: tFontinfo;
  824. BEGIN
  825.  WITH Terminal^ DO
  826.   font:= FontActive (TextHandle);
  827.   FontInfo (TextHandle, font, info);
  828.   size:= info.point;  full:= info.point;
  829.   IF info.fsm THEN INCL (Terminal^.zustand, cFSM);  half:= full DIV 2;
  830.               ELSE EXCL (Terminal^.zustand, cFSM);  half:= full - 1;
  831.   END;
  832.   zBreite:= info.boxw;
  833.   zHoehe:= info.boxh;
  834.   sp:= w DIV zBreite;
  835.   zl:= h DIV zHoehe;
  836.   mx:= x + (sp * zBreite) - 1;
  837.   my:= y + (zl * zHoehe) - 1;
  838.   lastCol:= mx - zBreite + 1;
  839.   lastLn:=  my - zHoehe + 1;
  840.   px:= x;
  841.   py:= y;
  842.   pmx:= x + zBreite;
  843.   pmy:= y + zHoehe;
  844.  END;
  845.  SetParameter;
  846. END UpdateTerminal;
  847.  
  848. (*--------------------------------------------------------------------------*
  849.  *                      Support fr mehrere Terminals                       *
  850.  *--------------------------------------------------------------------------*)
  851.  
  852. VAR     a, b, c:        sINTEGER;
  853.         count:          sINTEGER;
  854.  
  855.  
  856. PROCEDURE OpenTerminal (rect: ARRAY OF LOC): TERMINAL;
  857. VAR term:       TERMINAL;
  858.     r:          POINTER TO tRect;
  859.     i, j, s:    sINTEGER;
  860.     info:       tFontinfo;
  861. BEGIN
  862.  ALLOCATE (term,  TSIZE(TerminalTyp));  
  863.  IF term # NIL THEN
  864.   WITH term^ DO
  865.    r:= ADR (rect);  x:= r^.x;  y:= r^.y;  w:= r^.w;  h:= r^.h;
  866.    IF (w + x) > MaxWidth  THEN  w:= MaxWidth - x;   END;
  867.    IF (h + y) > MaxHeight THEN  h:= MaxHeight - y;  END;
  868.    font:= FontActive (TextHandle);
  869.    FontInfo (TextHandle, font, info);
  870.    size:= info.point;  full:= info.point;
  871.    IF info.fsm THEN INCL (term^.zustand, cFSM);  half:= full DIV 2;
  872.                ELSE EXCL (term^.zustand, cFSM);  half:= full - 1;
  873.    END;
  874.    zBreite:= info.boxw;
  875.    zHoehe:= info.boxh;
  876.    sp:= w DIV zBreite;
  877.    zl:= h DIV zHoehe;
  878.    mx:= x + (sp * zBreite) - 1;
  879.    my:= y + (zl * zHoehe) - 1;
  880.    lastCol:= mx - zBreite + 1;
  881.    lastLn:=  my - zHoehe + 1;
  882.    px:= x;
  883.    py:= y;
  884.    pmx:= x + zBreite;
  885.    pmy:= y + zHoehe;
  886.    vColor:= 1;
  887.    hColor:= 0;
  888.    xoff:= 0;
  889.    yoff:= 0;
  890.    tab:= 8;
  891.    effect:= Attribut{};  zustand:= {};
  892.   END; (* WITH *)
  893.  END;
  894.  RETURN term;
  895. END OpenTerminal;
  896.          
  897. PROCEDURE CloseTerminal (VAR term: TERMINAL);
  898. BEGIN
  899.  DEALLOCATE (term, 0);  
  900. END CloseTerminal;
  901.  
  902. PROCEDURE ChangeTerminal (term: TERMINAL): TERMINAL;
  903. VAR old: TERMINAL;
  904. BEGIN
  905.  old:= Terminal;
  906.  EXCL (old^.zustand, cActive);  INCL (term^.zustand, cActive);
  907.  Terminal:= term;
  908.  WITH Terminal^ DO
  909.   IF old^.font # font  THEN  FontSelect (TextHandle, font, FALSE);  END;
  910.   UpdateTerminal;
  911.   ForegroundColor (vColor);
  912.   BackgroundColor (hColor);
  913.   SetAttribut (effect);
  914.  END;
  915.  SetParameter;
  916.  RETURN old;
  917. END ChangeTerminal;
  918.  
  919. PROCEDURE GetMaximum (VAR rect: ARRAY OF LOC);
  920. VAR r: POINTER TO tRect;
  921. BEGIN
  922.  r:= ADR (rect);
  923.  r^.x:= MinX;  r^.y:= MinY;  r^.w:= MaxWidth;  r^.h:= MaxHeight;
  924. END GetMaximum;
  925.  
  926. PROCEDURE GetTerminal (VAR rect: ARRAY OF LOC);
  927. VAR r: POINTER TO tRect;
  928. BEGIN
  929.  r:= ADR (rect);
  930.  r^.x:= Terminal^.x;
  931.  r^.y:= Terminal^.y;
  932.  r^.w:= Terminal^.w;
  933.  r^.h:= Terminal^.h;
  934. END GetTerminal;
  935.  
  936. PROCEDURE SetTerminal (rect: ARRAY OF LOC);
  937. VAR r: POINTER TO tRect;
  938.     i, chw, chh, boxw, boxh: sINTEGER;
  939. BEGIN
  940.  WITH Terminal^ DO
  941.   r:= ADR (rect);  x:= r^.x;  y:= r^.y;  w:= r^.w;  h:= r^.h;
  942.   IF (w + x) > MaxWidth  THEN  w:= MaxWidth - x;   END;
  943.   IF (h + y) > MaxHeight THEN  h:= MaxHeight - y;  END;
  944.   UpdateTerminal;
  945.  END;
  946. END SetTerminal;
  947.  
  948. PROCEDURE ClipRect (doit: BOOLEAN; rct: ARRAY OF LOC);
  949. VAR r: POINTER TO tRect;
  950. BEGIN
  951.  r:= ADR (rct);
  952.  IF doit THEN
  953.   rect.x:= r^.x;
  954.   rect.y:= r^.y;
  955.   rect.w:= r^.x + r^.w - 1;
  956.   rect.h:= r^.y + r^.h - 1; 
  957.   MagicVDI.SetClipping(TextHandle,   rect, TRUE);
  958.   MagicVDI.SetClipping(NormalHandle, rect, TRUE);
  959.   MagicVDI.SetClipping(InversHandle, rect, TRUE);
  960.  ELSIF (italic IN Terminal^.effect) THEN
  961.   rect.x:= Terminal^.x;
  962.   rect.y:= Terminal^.y;
  963.   rect.w:= Terminal^.mx;
  964.   rect.h:= Terminal^.my;
  965.   MagicVDI.SetClipping(TextHandle, rect, TRUE);
  966.   MagicVDI.SetClipping(NormalHandle, rect, FALSE);
  967.   MagicVDI.SetClipping(InversHandle, rect, FALSE);
  968.  ELSE
  969.   MagicVDI.SetClipping(TextHandle,   rect, FALSE);
  970.   MagicVDI.SetClipping(NormalHandle, rect, FALSE);
  971.   MagicVDI.SetClipping(InversHandle, rect, FALSE);
  972.  END;
  973. END ClipRect;
  974.  
  975. PROCEDURE RedrawTerminal (term: TERMINAL; rect: ARRAY OF LOC);
  976. BEGIN
  977. END RedrawTerminal;
  978.  
  979. (*-------------------------------------------------------------------------*)
  980.  
  981. VAR j, i, i1, i2, i3, i4:  sINTEGER;
  982.     x:  TERMINAL;
  983.     r:  tRect;
  984.  
  985. BEGIN
  986.  count:= 0;  dPtr:= ADR(d);  qPtr:= ADR(q);
  987.  control7:= ADR (MagicVDI.VDIControl[7]);
  988.  control9:= ADR (MagicVDI.VDIControl[9]);
  989.  
  990.  InversHandle:= OpenWorkstation (Screen, 0, 0, TRUE);
  991.  i:= MagicVDI.SetWritemode (InversHandle, MagicVDI.XOR);
  992.  i:= MagicVDI.SetFillinterior (InversHandle, MagicVDI.Full);
  993.  i:= MagicVDI.SetFillcolor (InversHandle, 1);
  994.  
  995.  NormalHandle:= OpenWorkstation (Screen, 0, 0, TRUE);
  996.  i:= MagicVDI.SetWritemode (NormalHandle, MagicVDI.REPLACE);
  997.  i:= MagicVDI.SetFillinterior (NormalHandle, MagicVDI.Full);
  998.  i:= MagicVDI.SetFillcolor (NormalHandle, 0);
  999.  
  1000.  TextHandle:=   OpenWorkstation (Screen, 0, 0, TRUE);
  1001.  i:= MagicVDI.SetTextface (TextHandle, 1);
  1002.  i:= MagicVDI.SetWritemode (TextHandle, MagicVDI.REPLACE);
  1003.  i:= MagicVDI.SetTextcolor (TextHandle, 1);
  1004.  MagicVDI.SetTextalignment (TextHandle, 0, 5, i, i);
  1005.  
  1006.  r.x:= 0;  r.y:= 0;  r.w:= MaxWidth;  r.h:= MaxHeight;
  1007.  Terminal:= OpenTerminal (r);
  1008.  IF Terminal = NIL THEN HALT; END;
  1009.  Terminal^.zustand:= {cActive};
  1010.  SetParameter;
  1011. END mtTerminal.
  1012.  
  1013.